home *** CD-ROM | disk | FTP | other *** search
/ DOpus Plus / DOpus Plus.iso / Enhancements / DirTree / ARexx / DirTree.dopus5
Encoding:
Text File  |  1998-10-23  |  8.2 KB  |  302 lines
  1. /*
  2. $VER: DirTree.dopus5 0.8 (23.10.98)
  3.  
  4. Displays a simple directory tree in a lister and allows you to:
  5.  
  6. a) Doubleclick on a directory to read it into the lister.
  7. b) Drop files on to a directory to copy/move them.
  8. c) Drag'n'Drop a directory into another lister for reading.
  9. d) Drag'n'Drop between DirTree listers to do some grafting.
  10.  
  11. Drag'n'Drop to Copy, hold down shift key to Move.
  12.  
  13. Call as:  ARexx  DOpus5:ARexx/DirTree.dopus5 [REGEN|CREATE] <Device>
  14.  
  15.           Flags  Run Async
  16.  
  17.   where:  REGEN  = forces a new directory tree file to be created.
  18.           CREATE = just creates the directory tree file then exits.
  19.           Device = the device, eg. HD0:, SD0:, DF0:, etc.
  20.  
  21. Examples:  DirTree.dopus5 HD0:
  22.            DirTree.dopus5 REGEN HD1:
  23.            DirTree.dopus5 CREATE DH2:
  24.  
  25. NOTE: For each device that you run this script on, a file called '.dirtree'
  26.       will be created in the root directory.  Reading the directory tree can
  27.       take a while, but only needs to be done once, UNLESS you delete the
  28.       '.dirtree' file or specify the REGEN option.
  29.  
  30. Tip: ReOrg your HD, it'll make the listing of directories a lot faster.
  31.  
  32. REQUIRES: rexxtricks.library in Libs:  can be found on Aminet as
  33.           util/rexx/RexxTricks_386.lha
  34.  
  35.           A working PIPE: device!  (Required for grafting.)
  36.  
  37. */
  38. graft = 1    /* Grafting is a function in BETA state, if you don't want or */
  39.              /* don't trust it then set to 0.                              */
  40. stored = 0
  41. lf = '0a'x
  42.  
  43. options results
  44. parse arg regen device
  45. if device = '' then device = regen
  46. create = upper(regen) = 'CREATE'
  47. regen = regen ~= device
  48.  
  49. address 'DOPUS.1'
  50. if ~show('l','rexxsupport.library') then
  51.   call addlib('rexxsupport.library',0,-30)
  52. if ~show('l','rexxtricks.library') then
  53.   if ~addlib('rexxtricks.library',0,-30) then do
  54.     dopus request '"Unable to load rexxtricks.library" OK'
  55.     exit
  56.     end
  57. if ~showlist('h','PIPE') & graft then do
  58.   text = '"PIPE: device not mounted'||lf||'Disable Grafting or Mount PIPE:" Disable|Mount'
  59.   if ~exists('DEVS:DOSDrivers/PIPE') then
  60.     if ~exists('SYS:Storage/DOSDrivers/PIPE') then
  61.       text = '"PIPE: device not found'||lf||'Grafting disabled!" OK'
  62.     else stored = 1
  63.   dopus request text
  64.   if ~rc then
  65.     if stored then
  66.       address command 'Mount SYS:Storage/DOSDrivers/PIPE'
  67.     else
  68.       address command 'Mount PIPE:'
  69.   end
  70. graft = showlist('h','PIPE') & graft
  71.  
  72. device = strip(strip(device,,'"'))
  73. if pos(':',device) = 0 then do
  74.   dopus request '"Specify DEVICE only, eg. ''HD0:''" OK'
  75.   exit
  76.   end
  77. device = left(device,pos(':',device))
  78. if ~exists(device) then do
  79.   dopus request '"Device '''device''' does not exist!" OK'
  80.   exit
  81.   end
  82. oldcd = pragma('d',device)
  83. device = pragma('d',oldcd)
  84. tfile = device||'.dirtree'
  85. if regen then call delete(tfile)
  86.  
  87. call whowantssome
  88.  
  89. lister new invisible mode name
  90. handle = result
  91. lister set handle field off
  92. lister set handle toolbar
  93. lister set handle busy on
  94. lister set handle path ''
  95. lister set handle title 'DirTree of 'device
  96. lister set handle header 'Total of 'dirs.0' dirs.'
  97. lister refresh handle full
  98. lister set handle visible on
  99. call rackemup
  100. lister set handle busy off
  101.  
  102. handlerport = 'DirTree'handle
  103. call openport(handlerport)
  104. lister set handle handler handlerport subdrop quotes nopopups
  105.  
  106. do until event = 'inactive'
  107.   if waitpkt(handlerport) then do
  108.     packet = getpkt(handlerport)
  109.     if packet ~= '00000000'x then do
  110.       event = getarg(packet,0)
  111.       namestr = getarg(packet,2)
  112.       user = getarg(packet,3)
  113.       args = getarg(packet,5)
  114.       qualifier = getarg(packet,6)
  115.       select
  116.       when event = 'reread' then do
  117.         call delete(tfile)
  118.         call whowantssome
  119.         call rackemup
  120.         end
  121.       when event = 'doubleclick' | event = 'path' then do
  122.         if event ~= 'path' then do
  123.           lister query handle value namestr
  124.           namestr = result
  125.           end
  126.         lister set handle handler
  127.         lister set handle toolbar toolbar
  128.         lister set handle field on
  129.         lister wait handle quick
  130.         lister read handle namestr force
  131.         leave
  132.         end
  133.       when event = 'drop' & index(qualifier,'subdrop') > 0 then do
  134.         if index(qualifier,'shift') then
  135.           cmd = 'Move'
  136.         else
  137.           cmd = 'Copy'
  138.         if checkhandler(user) then do
  139.           lister query handle value args
  140.           path = result
  141.           rescan = 0
  142.           call getall
  143.           do i = 1 to entries.count
  144.             'command original wait 'cmd' NAME='entries.i' TO='path
  145.           end
  146.           if rescan then do
  147.             call delete(tfile)
  148.             call whowantssome
  149.             call rackemup
  150.             end
  151.           end
  152.         else if graft then call graftit
  153.         end
  154.       when event = 'dropfrom' then do
  155.         if checkhandler(user) then do
  156.           parse var namestr line namestr
  157.           lister query handle value line
  158.           path = result
  159.           lister read user path force
  160.           end
  161.         else if graft then call graftwait
  162.         end
  163.       otherwise
  164.       end
  165.       call reply(packet,0)
  166.       if event ~= 'inactive' then do
  167.         lister set handle header 'Total of 'dirs.0' dirs.'
  168.         lister refresh handle full
  169.         end
  170.       end
  171.     end
  172. end
  173.  
  174. call closeport(handlerport)
  175. exit
  176.  
  177. getall:
  178. i = 0
  179. do while namestr ~= ''
  180.   i = i + 1
  181.   parse var namestr '"' entries.i '"' namestr
  182.   lister query user entry '"'entries.i'"' stem fileinfo.
  183.   if fileinfo.TYPE > 0 then rescan = 1
  184. end
  185. entries.count = i
  186. return
  187.  
  188. checkhandler: procedure
  189. parse arg user
  190. lister query user handler
  191. return (result = 'RESULT' | result = '')
  192.  
  193. graftit:
  194. lister query user handler
  195. otoh = result
  196. if left(otoh,7) ~= 'DirTree' then return
  197. lister query handle value args
  198. newpath = result
  199. call getall
  200. lister query user value entries.1
  201. origpath = result
  202. if right(origpath,1) = ':' then return
  203. origdev = left(origpath,pos(':',origpath))
  204. ofile = origdev'.dirtree'
  205. call readfile(ofile,'odirs')
  206. oindex = lsearch('~('origpath'#?)','odirs',entries.1,'n','p')
  207. if oindex = -1 then oindex = odirs.0 + 1
  208. 'command original wait 'cmd' NAME="'origpath'" TO="'newpath'"'
  209. if ~rc then do
  210.   ptail = lastpos('/',origpath)
  211.   do i = entries.1 to oindex - 1
  212.     odirs.i = newpath||substr(odirs.i,ptail)
  213.   end
  214.   call steminsert('dirs',2,oindex - entries.1,'')
  215.   call stemcopy('odirs',entries.1,'dirs',2,oindex - entries.1)
  216.   call qsort('dirs')
  217.   call delete(tfile)
  218.   call writefile(tfile,'dirs')
  219.   call rackemup
  220.   if cmd = 'Move' then do
  221.     call stemremove('odirs',entries.1,oindex - entries.1)
  222.     call delete(ofile)
  223.     call qsort('odirs')
  224.     call writefile(ofile,'odirs')
  225.     address command 'echo >pipe:'otoh' 1'
  226.     end
  227.   else address command 'echo >pipe:'otoh' 0'
  228.   end
  229. else do
  230.   dopus request '"The Graft failed!" OK'
  231.   address command 'echo >pipe:'otoh' 0'
  232.   end
  233. return
  234.  
  235. graftwait:
  236. lister query user handler
  237. otoh = result
  238. if left(otoh,7) ~= 'DirTree' then return
  239. call open('inpipe','PIPE:'handlerport,'r')
  240. wasit = readch('inpipe')
  241. call close('inpipe')
  242. if wasit then do
  243.   call whowantssome
  244.   call rackemup
  245.   end
  246. return
  247.  
  248. rackemup:
  249. lister clear handle
  250. lister refresh handle
  251. info.NAME = copies('0',nlength)
  252. info.TYPE = 4
  253. info.DISPLAY = device
  254. lister addstem handle info.
  255. lister set handle value info.NAME device
  256. info.TYPE = 1
  257. do j = 1 to dirs.0
  258.   dirline = dirs.j
  259.   path = dirline
  260.   if pos(':',dirline) ~= 0 then parse var dirline dev ':' dirline
  261.   if dirline ~= '' then do
  262.     if pos('/',dirline) ~= 0 then do
  263.       howmany = 0
  264.       do while pos('/',dirline) ~= 0
  265.         parse var dirline fore'/'dirline
  266.         howmany = howmany + 1
  267.       end
  268.       dirline = copies(' ',3 * howmany)||dirline
  269.       end
  270.     dirline = '   '||dirline
  271.     do i = 1 to length(dirline) by 3
  272.       if substr(dirline,i + 3,3) ~= '   ' then do
  273.         dirline = overlay('+--',dirline,i)
  274.         leave
  275.         end
  276.     end
  277.     info.NAME = right(j,nlength,'0')
  278.     info.DISPLAY = dirline
  279.     lister addstem handle info.
  280.     lister refresh handle
  281.     lister set handle value info.NAME path
  282.     end
  283. end
  284. return
  285.  
  286. whowantssome:
  287. if ~exists(tfile) then do
  288.   call getdir(device,,'dirs','d','p','s')
  289.   call qsort('dirs')
  290.   call writefile(tfile,'dirs')
  291.   'command protect 'tfile' set H'
  292.   if create then exit
  293.   end
  294. else do
  295.   if ~readfile(tfile,'dirs') then do
  296.     dopus request '"ERROR: Unable to open '''tfile''' file." OK'
  297.     exit
  298.     end
  299.   end
  300. nlength = length(dirs.0)
  301. return
  302.